perm filename TRUNC.OLD[SCR,LCS] blob sn#369170 filedate 1978-07-26 generic text, type T, neo UTF8
	SUBROUTINE TRUNC
	DIMENSION PX(2592),PXL(2592),COPY(1),COPYL(1)
C  96*27=2592  STARTS WITH PARAM #4 → 99.
	COMMON INUM,M,CNT(1) /P/P(1) /PL/PL(1) /COPY/NUMP,COPY,COPYL
	1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,BY,
	1 KODE,NPAR,LP,TBG,AC,NPA
	L=(INUM-1)*96-3
	IF(CNT(INUM).GT.1)GO TO 3
C INIT THE LIST.
	DO 4 K=4,NPA
4	PX(K+L)='$'
3	NPX=0
	DO 1 K=NPA,4,-1
	N=K+L
	X=PL(K)
	IF(P(K).NE.PX(N))GO TO 2
CC	IF(X.GT.2)GO TO 2
	IF(X.EQ.PXL(N))GO TO 1
2	IF(NPX.EQ.0)NPX=K
	PX(N)=P(K)
	PXL(N)=X
1	CONTINUE
	NPA=3
	IF(NPX.NE.0)NPA=NPX
	END